home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / SNOW00.ZIP / SNOW.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1996-11-13  |  4.3 KB  |  148 lines
  1. {  SNOW demo by Rafhel.  This is my first attempt to do a graphics demo.          }
  2. {  It is very simple to do this demo, and I know there are better ways to code it.}
  3. {  I've made it thanx to Denthor's VGA tutorials.                                 }
  4. {  The documentation is not too good; I hope it is helpful to other people who,   }
  5. {  like me, is starting on fascinating world of coding!!!! :) .   I'm trying to   }
  6. {  build up a programming group, so if you are interested   (no matter what part  }
  7. {  of the world you are), contact me at rpachec@elecrisc.ing.ucv.edu .   }
  8. {  Copyright 1996 : Rafhel.  }
  9. {  Notice:  You're using this program at your own risk. }
  10.  
  11. program neva;
  12. uses crt;
  13.  const
  14.    nm = 28;  {the number of elements in TABLA}
  15.    nm2 = 5;   { every nm2 times, the flake's x-movement is updated (see below) }
  16.    vga = $a000;
  17.    numcopos = 50; { number of flakes visualized}
  18.    ffact = 15;     { This variable helps with delaying the demo }
  19.  
  20. type
  21.   matriz = array[1..nm] of integer;
  22.  
  23.   copo = record   {  flake's atributes}
  24.     x,y,x0 : integer;
  25.     xold,yold : integer;
  26.     lim : integer;
  27.     factor : integer;
  28.     factor2 : integer;
  29.     vibra : integer;
  30.     color : byte;
  31.     esc : byte;
  32.     edad : integer;   {  edad is the "life" of the flake.  When it finishes its fall,}
  33.   end;                { the flake still vibrates for a while (thanx to edad) so }
  34.                       {if it finds a lower place, it'll fall onto it.}
  35.                       { This makes a more "real" snow floor }
  36.   nevada = array[1..numcopos] of copo;
  37. const
  38.    tabla : matriz = (1,2,2,2,2,3,3,3,3,2,2,2,2,1,-1,-2,-2,-2,-2,-3,-3,-3,-3,-2,-2,-2,-2,-1);
  39.  
  40. { matriz is a very-simple sin table (used in flake's x-movement) }
  41.  
  42. var
  43.   pr : longint;
  44.   i,o : integer;
  45.   nieve : nevada; {nieve is snow in spanish...}
  46.                   { nevada is snowstorm }
  47.  
  48. procedure iniciar (var nevada0 : copo);
  49. var
  50.   cole : byte;
  51. begin
  52.   with nevada0 do begin
  53.   if random(100) < 10 then cole :=7 else cole :=30;  { Choose between two colors}
  54.     y:=0;
  55.     x0:=random(310)+5;
  56.     xold:=x;
  57.     yold:=y;
  58.     lim:=20;
  59.     factor:=lim;
  60.     factor2:=ffact;
  61.     esc := nm2;
  62.     edad:=random(500);
  63.     vibra:=random(nm);
  64.     x:=x0;
  65.     color:=cole;
  66.   end;
  67. end;
  68.  
  69.  
  70.  
  71. procedure setvga; assembler;
  72. asm
  73.    mov ax,0013h
  74.    int 10h
  75. end;
  76.  
  77. { procedure escalar is used in the flake's x-movement. }
  78.  
  79.  
  80. procedure escalar( var esc2 : byte; var vibra2 : integer);
  81. begin
  82.   dec(esc2);
  83.   if esc2=0 then begin esc2:=nm2;inc(vibra2);
  84.     if vibra2=nm then vibra2:=0;
  85.   end;
  86. end;
  87.  
  88. procedure settext; assembler;
  89. asm
  90.   mov ax,0003h;
  91.   int 10h;
  92. end;
  93.  
  94.  
  95. procedure pokevga(xx,yy : longint; valor : byte);
  96. begin
  97.   mem[vga:yy*320+xx]:=valor;
  98. end;
  99.  
  100.  
  101. function getpixel(x,y: longint) : boolean;  { Indicates if a pixel is on }
  102. begin
  103.   pr:=y*320+x;
  104.   getpixel:=not(mem[vga:pr]=0);
  105. end;
  106.  
  107. begin
  108.   randomize;
  109.   for i:=1 to numcopos do  begin
  110.     iniciar(nieve[i]);
  111.     nieve[i].y:=random(200);
  112.   end;
  113.   setvga;
  114.   for i:=10 to 200 do pokevga(i,90,1);
  115.   while not keypressed do begin
  116.     for i:=1 to numcopos do
  117.       with nieve[i]  do begin
  118.         if random(100)<5 then begin  {this helps in making the snow floor more "real"}
  119.         escalar(esc,vibra);
  120.         x:=x0+tabla[vibra];
  121.       end;
  122.  
  123.       dec(factor);                       { I wanted the flakes to do a free-fall }
  124.       if factor=0 then begin              {movement.  Playing around with the values of}
  125.       factor:=lim;                         {lim, nm2 and ffact helps understanding}
  126.       dec(factor2);                         {the algorithm.  Of course, I know}
  127.       if factor2=0 then begin dec(lim);   {there are other better ways to do the job,}
  128.         if lim=0 then lim:=1;              {but I used the first idea that came to my head}
  129.         factor2:=ffact;
  130.       end;
  131.  
  132.       if getpixel(x,y+1) or (y > 198) then begin  {this part finds out wether the}
  133.          dec(edad);                            {snowflake has finished its fall.}
  134.          if edad=0 then iniciar(nieve[i]);
  135.       end else begin
  136.         escalar(esc,vibra);
  137.         x:=x0+tabla[vibra];
  138.         inc(y);
  139.         pokevga(xold,yold,0);
  140.         pokevga(x,y,color);
  141.         xold:=x; yold:=y;
  142.       end;
  143.     end;
  144.   end;
  145.  end;
  146.  settext;
  147.  
  148. end.